#!/usr/bin/perl -s

use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval);
use vars '$iword';

# build internal db in memory
my %wordlist;
my $j = 0;
while (<>) {
    s/\r?\n/\n/; # sanitize newline characters (1)
    chomp; # remove trailing newline (2)
    s/^\s+//g; s/\s+$//g; # trim unwanted spaces (3)
    # (1) and (3) are unnecessary if you trust your source list

    my $len = length;
    next if $wordlist{$len}{letters}{$_}; # discard duplicated words

    my @letters = split //;
    for my $l (@letters) {
        $wordlist{$len}{letters}{$_}{$l}++;
    }
    $j++;
}

for my $x (keys %wordlist) {
    my @match_words = sort { $a cmp $b } keys %{ $wordlist{$x}{letters} };
    $wordlist{$x}{words} = [@match_words];
}

print "the database contains $j entries\n";

my $quit = 0;
while (!$quit) {
    print "\nquiz: ";

    if ($iword) {  # one-time mode
        print "$iword\n";
        $_ = $iword;
    }
    else {
        chomp($_ = <>);
    }

    redo unless defined and length;
    last if $_ eq '0'; # quit the game

    my $t0 = [gettimeofday];

    my %input_letter;
    my $input_length = length;
    my @letters = split //;
    for my $l (@letters) {
        $input_letter{$l}++;
    }

    print "input $_ with length of $input_length character(s), consists of:\n";
    for my $x (sort { $input_letter{$b} <=> $input_letter{$a} } keys %input_letter) {
        print " $x ($input_letter{$x})";
    }

    my $len_match_words = $wordlist{$input_length}{words};
    printf "\npossible match: %d words\n", scalar(@$len_match_words);

    my $correct = 0;
    my $ok = 0;

    print "narrow search result:\n";
    FIND: for my $word (@$len_match_words) {
        my $word_props = $wordlist{$input_length}{letters}{$word};

        $correct = 0;
        for (my $k = 0; $k < @letters; $k++) {
            my $current_letter = $letters[$k];
            my $input_letter_count = $input_letter{$current_letter};

            next FIND
                unless $word_props->{$current_letter} && $input_letter_count == $word_props->{$current_letter};
            $correct++;
        }

        next unless $correct == @letters;
        print " $word\n";
        $ok++;

    }

    printf "final: $ok word(s), elapsed: %.3f seconds\n", tv_interval($t0);
    last if $iword; # one-time mode
}

# by @hasant
